Syntax10.Scn.Fnt
StampElems
Alloc
20 Mar 96
Syntax10b.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
MODULE Folds;	(* HM 
IMPORT
	Display, Input, Files, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
CONST
	profile = "Folds.Profile";
	CR = 0DX;
	ErrElem = POINTER TO ErrElemDesc;
	ErrElemDesc = RECORD(Texts.ElemDesc)
		err: INTEGER
	END;
	Options = ARRAY 16 OF CHAR;
	w: Texts.Writer;
	errT: Texts.Text;
	compName, errFile: ARRAY 24 OF CHAR;
	globOpt: Options;
	showWarnings: BOOLEAN;
PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);	
END NoNotify;
PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;	
BEGIN RETURN e IS ErrElem
END ErrCheck;
PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);	
	VAR i: INTEGER;
BEGIN i := 0;
	WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
	IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
		REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
	END;
	opt[i] := 0X
END GetOptions;
PROCEDURE MarkedFrame (): TextFrames.Frame;	
	VAR v: Viewers.Viewer;
BEGIN v := Oberon.MarkedViewer();
	IF v.dsc.next IS TextFrames.Frame THEN RETURN v.dsc.next(TextFrames.Frame)
	ELSE RETURN NIL
END MarkedFrame;
PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);	
	VAR x, y, h: INTEGER;
BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
	v := MenuViewers.New(TextFrames.NewMenu("", ""),
 TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
	Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
	Viewers.minH := h
END OpenTempViewer;
PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);	
	VAR end, delta: LONGINT;
BEGIN delta := 200;
	LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
		IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
		TextFrames.Show(f, pos - delta); DEC(delta, 20)
END Show;
PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);	
	VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
BEGIN
	WITH E: ErrElem DO
		WITH
			 msg: TextFrames.DisplayMsg DO
				IF ~msg.prepare THEN
					w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
					Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 2, w - 2, h, Display.replace)
				END
		| msg: TextFrames.TrackMsg DO
				REPEAT
					Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
				UNTIL keys = {}
		| msg: Texts.CopyMsg DO
				NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
		ELSE (*ignore it*)
		END
END HandleErr;
PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text);	
	VAR S: Texts.Scanner; pos, delta: LONGINT; err: INTEGER; log: Texts.Text; r: Texts.Reader; ch: CHAR; e: ErrElem;
BEGIN
	log := Oberon.Log; pos := log.len;
	REPEAT DEC(pos); Texts.OpenReader(r, log, pos); Texts.Read(r, ch) UNTIL ch = "c";
	REPEAT INC(pos); Texts.Read(r, ch) UNTIL ch < " ";
	delta := 0; Texts.OpenScanner(S, log, pos+1);
	LOOP S.line := 0;
		REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
		IF S.eot OR (S.line # 0) THEN EXIT END;
		pos := S.i;
		REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
		IF S.eot OR (S.line # 0) THEN EXIT END;
		IF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
			NEW(e); e.W := 3*TextFrames.mm; e.H := e.W; e.handle := HandleErr; e.err := SHORT(S.i);
			Texts.WriteElem(w, e); Texts.Insert(t, pos + delta, w.buf);
			INC(delta)
		END;
		REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
END InsertErrElems;
PROCEDURE DeleteErrElems (t: Texts.Text);	
	VAR r: Texts.Reader; pos: LONGINT;
BEGIN Texts.OpenReader(r, t, 0);
	LOOP Texts.ReadElem(r);
		IF r.elem = NIL THEN EXIT
		ELSIF r.elem IS ErrElem THEN
			pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos)
		END
END DeleteErrElems;
PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;	
	VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
	IF end + 1 = f.text.len THEN INC(end) END; 
		-- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
	Texts.OpenReader(r, f.text, f.org);
	LOOP Texts.ReadElem(r);
		IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
		ELSIF r.elem IS ErrElem THEN RETURN TRUE
		END
END ErrVisible;
PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);	
	VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
BEGIN Texts.OpenScanner(s, errT, 0);
	REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
	WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
	IF ~s.eot THEN Texts.Read(s, ch); n := 0;
		WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
		msg[n] := 0X
END GetErrMsg;
PROCEDURE SetProfile*;	
	VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
BEGIN
	compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
	f := Files.Old(profile);
	IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
		WHILE ~ s.eot DO
			IF s.class = Texts.Name THEN
				IF s.s = "compiler" THEN
					Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
					GetOptions(s, globOpt)
				ELSIF s.s = "errorFile" THEN
					Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
				ELSIF s.s = "showWarnings" THEN
					Texts.Scan(s); Texts.Scan(s);
					showWarnings := s.s = "yes"
				END
			END;
			Texts.Scan(s)
		END
	END;
	errT := TextFrames.Text(errFile)
END SetProfile;
PROCEDURE Compile*;	
	VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
		beg, end, time: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
		ready: BOOLEAN; opt: Options;
BEGIN
	par := Oberon.Par;
	Texts.OpenScanner(s, par.text, par.pos); 
	REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
		IF par.vwr.dsc = par.frame THEN
			f := par.frame.next(TextFrames.Frame);
			Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
			Oberon.FadeCursor(Oberon.Pointer);
			t := f.text; opt := globOpt; ready := TRUE
		ELSE
			IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
			ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
				f := MarkedFrame(); IF f # NIL THEN t := f.text END;
				ready := TRUE
			ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
				Oberon.GetSelection(t, beg, end, time);
				IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s); 
					IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
				END
			END;
			GetOptions(s, opt)
		END;
		IF t # NIL THEN
			DeleteErrElems(t);
			oldNotify := t.notify; t.notify := NoNotify;
			FoldElems.ExpandAll(t, 0, TRUE);
			IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
			par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
			Texts.Append(par.text, w.buf); par.pos := 0;
			Oberon.Call(compName, par, FALSE, res);
			IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t) END;
			FoldElems.CollapseAll(t, {FoldElems.tempLeft});
			IF f = NIL THEN
				Viewers.Close(v)
			ELSE
				t.notify := oldNotify;
				IF ErrVisible(f) THEN t.notify(t, Texts.replace, 0, t.len) END
			END
		END
	UNTIL (t = NIL) OR ready
END Compile;
PROCEDURE ShowError*;	
	VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
BEGIN
	IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next;
	ELSE F := Oberon.MarkedViewer();
		IF (F .dsc # NIL) & (F.dsc.next # NIL) THEN F := F.dsc.next END ;
	END ;
	WITH F: TextFrames.Frame DO
		IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
		FoldElems.FindElem(F.text, pos, ErrCheck, e);		(*<<RD*)
		FoldElems.FindElem(F.text, pos, ErrCheck, e, pos);
		IF e # NIL THEN
			pos:=Texts.ElemPos(e);		(*<<RD*)
			Show(F, pos);
			TextFrames.SetCaret(F, pos + 1);
			GetErrMsg(e(ErrElem).err, msg);
			Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
		END
	ELSE
END ShowError;
PROCEDURE Restore*;	
	VAR f: TextFrames.Frame;
BEGIN
	f := MarkedFrame();
	IF f # NIL THEN FoldElems.CollapseAll(f.text, {FoldElems.findLeft}) END
END Restore;
BEGIN
	Texts.OpenWriter(w); SetProfile
END Folds.